home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 2010 April / PCWorld0410.iso / hity wydania / Ubuntu 9.10 PL / karmelkowy-koliberek-desktop-9.10-i386-PL.iso / casper / filesystem.squashfs / usr / bin / update-alternatives < prev    next >
Text File  |  2009-09-20  |  36KB  |  1,106 lines
  1. #!/usr/bin/perl --
  2.  
  3. BEGIN { # Work-around for bug #479711 in perl
  4.     $ENV{PERL_DL_NONLAZY} = 1;
  5. }
  6.  
  7. use strict;
  8. use warnings;
  9.  
  10. use POSIX qw(:errno_h);
  11. use Dpkg;
  12. use Dpkg::Gettext;
  13.  
  14. textdomain("dpkg");
  15.  
  16. # Global variables:
  17.  
  18. my $altdir = '/etc/alternatives';
  19. my $admdir = $admindir . '/alternatives';
  20.  
  21. my $action = '';      # Action to perform (display / query / install / remove / auto / config)
  22. my $alternative;      # Alternative worked on
  23. my $inst_alt;         # Alternative to install
  24. my $fileset;          # Set of files to install in the alternative
  25. my $path;             # Path of alternative we are offering
  26. my $log_file = "/var/log/dpkg.log";
  27. my $skip_auto = 0;    # Skip alternatives properly configured in auto mode (for --config)
  28. my $verbosemode = 0;
  29. my $force = 0;
  30. my @pass_opts;
  31.  
  32. $| = 1;
  33.  
  34. #
  35. # Main program
  36. #
  37.  
  38. my @COPY_ARGV = @ARGV;
  39. while (@ARGV) {
  40.     $_ = shift(@ARGV);
  41.     last if m/^--$/;
  42.     if (!m/^--/) {
  43.         error(_g("unknown argument \`%s'"), $_);
  44.     } elsif (m/^--help$/) {
  45.         usage();
  46.         exit(0);
  47.     } elsif (m/^--version$/) {
  48.         version();
  49.         exit(0);
  50.     } elsif (m/^--verbose$/) {
  51.         $verbosemode= +1;
  52.         push @pass_opts, $_;
  53.     } elsif (m/^--quiet$/) {
  54.         $verbosemode= -1;
  55.         push @pass_opts, $_;
  56.     } elsif (m/^--install$/) {
  57.     set_action("install");
  58.         @ARGV >= 4 || badusage(_g("--install needs <link> <name> <path> <priority>"));
  59.         my $link = shift @ARGV;
  60.         my $name = shift @ARGV;
  61.         my $path = shift @ARGV;
  62.         my $priority = shift @ARGV;
  63.         badusage(_g("<link> and <path> can't be the same")) if $link eq $path;
  64.         $priority =~ m/^[-+]?\d+/ || badusage(_g("priority must be an integer"));
  65.         $alternative = Alternative->new($name);
  66.         $inst_alt = Alternative->new($name);
  67.         $inst_alt->set_status("auto");
  68.         $inst_alt->set_link($link);
  69.         $fileset = FileSet->new($path, $priority);
  70.     } elsif (m/^--(remove|set)$/) {
  71.     set_action($1);
  72.         @ARGV >= 2 || badusage(_g("--%s needs <name> <path>"), $1);
  73.         $alternative = Alternative->new(shift(@ARGV));
  74.         $path = shift @ARGV;
  75.     } elsif (m/^--(display|query|auto|config|list|remove-all)$/) {
  76.     set_action($1);
  77.         @ARGV || badusage(_g("--%s needs <name>"), $1);
  78.         $alternative = Alternative->new(shift(@ARGV));
  79.     } elsif (m/^--(all|get-selections|set-selections)$/) {
  80.     set_action($1);
  81.     } elsif (m/^--slave$/) {
  82.         badusage(_g("--slave only allowed with --install"))
  83.             unless $action eq "install";
  84.         @ARGV >= 3 || badusage(_g("--slave needs <link> <name> <path>"));
  85.         my $slink = shift @ARGV;
  86.         my $sname = shift @ARGV;
  87.         my $spath = shift @ARGV;
  88.         badusage(_g("<link> and <path> can't be the same")) if $slink eq $spath;
  89.         badusage(_g("name %s is both primary and slave"), $inst_alt->name())
  90.             if $sname eq $inst_alt->name();
  91.         if ($inst_alt->has_slave($sname)) {
  92.             badusage(_g("slave name %s duplicated"), $sname);
  93.         }
  94.         foreach my $slave ($inst_alt->slaves()) {
  95.             my $link = $inst_alt->slave_link($slave) || "";
  96.             badusage(_g("slave link %s duplicated"), $slink) if $link eq $slink;
  97.             badusage(_g("link %s is both primary and slave"), $slink)
  98.                 if $link eq $inst_alt->link();
  99.         }
  100.         $inst_alt->add_slave($sname, $slink);
  101.         $fileset->add_slave($sname, $spath);
  102.     } elsif (m/^--log$/) {
  103.         @ARGV || badusage(_g("--%s needs a <file> argument"), "log");
  104.         $log_file = shift @ARGV;
  105.         push @pass_opts, $_, $log_file;
  106.     } elsif (m/^--altdir$/) {
  107.         @ARGV || badusage(_g("--%s needs a <directory> argument"), "altdir");
  108.         $altdir = shift @ARGV;
  109.         push @pass_opts, $_, $altdir;
  110.     } elsif (m/^--admindir$/) {
  111.         @ARGV || badusage(_g("--%s needs a <directory> argument"), "admindir");
  112.         $admdir = shift @ARGV;
  113.         push @pass_opts, $_, $admdir;
  114.     } elsif (m/^--skip-auto$/) {
  115.     $skip_auto = 1;
  116.         push @pass_opts, $_;
  117.     } elsif (m/^--force$/) {
  118.     $force = 1;
  119.         push @pass_opts, $_;
  120.     } else {
  121.         badusage(_g("unknown option \`%s'"), $_);
  122.     }
  123. }
  124.  
  125. badusage(_g("need --display, --query, --list, --get-selections, --config," .
  126.             "--set, --set-selections, --install, --remove, --all, " .
  127.             "--remove-all or --auto"))
  128.     unless $action;
  129.  
  130. # Load infos about all alternatives to be able to check for mistakes
  131. my %ALL;
  132. foreach my $alt_name (get_all_alternatives()) {
  133.     my $alt = Alternative->new($alt_name);
  134.     next unless $alt->load("$admdir/$alt_name", 1);
  135.     $ALL{objects}{$alt_name} = $alt;
  136.     $ALL{links}{$alt->link()} = $alt_name;
  137.     $ALL{parent}{$alt_name} = $alt_name;
  138.     foreach my $slave ($alt->slaves()) {
  139.         $ALL{links}{$alt->slave_link($slave)} = $slave;
  140.         $ALL{parent}{$slave} = $alt_name;
  141.     }
  142. }
  143. # Check that caller don't mix links between alternatives and don't mix
  144. # alternatives between slave/master, and that the various parameters
  145. # are fine
  146. if ($action eq "install") {
  147.     my ($name, $link, $file) = ($inst_alt->name(), $inst_alt->link(), $fileset->master());
  148.     if (exists $ALL{parent}{$name} and $ALL{parent}{$name} ne $name) {
  149.         error(_g("alternative %s can't be master: %s"), $name,
  150.               sprintf(_g("it is a slave of %s"), $ALL{parent}{$name}));
  151.     }
  152.     if (exists $ALL{links}{$link} and $ALL{links}{$link} ne $name) {
  153.         error(_g("alternative link %s is already managed by %s."),
  154.               $link, $ALL{parent}{$ALL{links}{$link}});
  155.     }
  156.     error(_g("alternative link is not absolute as it should be: %s"),
  157.           $link) unless $link =~ m|^/|;
  158.     error(_g("alternative path is not absolute as it should be: %s"),
  159.           $file) unless $file =~ m|^/|;
  160.     error(_g("alternative path %s doesn't exist."), $file)
  161.         unless -e $file;
  162.     error(_g("alternative name (%s) must not contain '/' and spaces."), $name)
  163.         if $name =~ m|[/\s]|;
  164.     foreach my $slave ($inst_alt->slaves()) {
  165.         $link = $inst_alt->slave_link($slave);
  166.         $file = $fileset->slave($slave);
  167.         if (exists $ALL{parent}{$slave} and $ALL{parent}{$slave} ne $name) {
  168.             error(_g("alternative %s can't be slave of %s: %s"),
  169.                   $slave, $name, ($ALL{parent}{$slave} eq $slave) ?
  170.                       _g("it is a master alternative.") :
  171.                       sprintf(_g("it is a slave of %s"), $ALL{parent}{$slave})
  172.                  );
  173.         }
  174.         if (exists $ALL{links}{$link} and $ALL{links}{$link} ne $slave) {
  175.             error(_g("alternative link %s is already managed by %s."),
  176.                   $link, $ALL{parent}{$ALL{links}{$link}});
  177.         }
  178.         error(_g("alternative link is not absolute as it should be: %s"),
  179.               $link) unless $link =~ m|^/|;
  180.         error(_g("alternative path is not absolute as it should be: %s"),
  181.               $file) unless $file =~ m|^/|;
  182.         error(_g("alternative name (%s) must not contain '/' and spaces."), $slave)
  183.             if $slave =~ m|[/\s]|;
  184.     }
  185. }
  186.  
  187. # Handle actions
  188. if ($action eq 'all') {
  189.     config_all();
  190.     exit 0;
  191. } elsif ($action eq 'get-selections') {
  192.     foreach my $alt_name (sort keys %{$ALL{objects}}) {
  193.         my $obj = $ALL{objects}{$alt_name};
  194.         printf "%-30s %-8s %s\n", $alt_name, $obj->status(), $obj->current() || "";
  195.     }
  196.     exit 0;
  197. } elsif ($action eq 'set-selections') {
  198.     log_msg("run with @COPY_ARGV");
  199.     my $line;
  200.     my $prefix = "[$progname --set-selections] ";
  201.     while (defined($line = <STDIN>)) {
  202.         chomp($line);
  203.         my ($alt_name, $status, $choice) = split(/\s+/, $line, 3);
  204.         if (exists $ALL{objects}{$alt_name}) {
  205.             my $obj = $ALL{objects}{$alt_name};
  206.             if ($status eq "auto") {
  207.                 pr($prefix . _g("Call %s."), "$0 --auto $alt_name");
  208.                 system($0, @pass_opts, "--auto", $alt_name);
  209.                 exit $? if $?;
  210.             } else {
  211.                 if ($obj->has_choice($choice)) {
  212.                     pr($prefix . _g("Call %s."), "$0 --set $alt_name $choice");
  213.                     system($0, @pass_opts, "--set", $alt_name, $choice);
  214.                     exit $? if $?;
  215.                 } else {
  216.                     pr($prefix . _g("Alternative %s unchanged because choice " .
  217.                        "%s is not available."), $alt_name, $choice);
  218.                 }
  219.             }
  220.         } else {
  221.             pr($prefix . _g("Skip unknown alternative %s."), $alt_name);
  222.         }
  223.     }
  224.     exit 0;
  225. }
  226.  
  227.  
  228. # Load the alternative info, stop on failure except for --install
  229. if (not $alternative->load("$admdir/" . $alternative->name())
  230.     and $action ne "install")
  231. {
  232.     # FIXME: Be consistent for now with the case when we try to remove a
  233.     # non-existing path from an existing link group file.
  234.     if ($action eq "remove") {
  235.         verbose(_g("no alternatives for %s."), $alternative->name());
  236.         exit 0;
  237.     }
  238.     error(_g("no alternatives for %s."), $alternative->name());
  239. }
  240.  
  241. if ($action eq 'display') {
  242.     $alternative->display_user();
  243.     exit 0;
  244. } elsif ($action eq 'query') {
  245.     $alternative->display_query();
  246.     exit 0;
  247. } elsif ($action eq 'list') {
  248.     $alternative->display_list();
  249.     exit 0;
  250. }
  251.  
  252. # Actions below might modify the system
  253. log_msg("run with @COPY_ARGV");
  254.  
  255. my $current_choice = '';
  256. if ($alternative->has_current_link()) {
  257.     $current_choice = $alternative->current();
  258.     # Detect manually modified alternative, switch to manual
  259.     if (not $alternative->has_choice($current_choice)) {
  260.         if (not -e $current_choice) {
  261.             warning(_g("%s is dangling, it will be updated with best choice."),
  262.                     "$altdir/" . $alternative->name());
  263.             $alternative->set_status('auto');
  264.         } elsif ($alternative->status() ne "manual") {
  265.             warning(_g("%s has been changed (manually or by a script). " .
  266.                     "Switching to manual updates only."),
  267.                     "$altdir/" . $alternative->name());
  268.             $alternative->set_status('manual');
  269.         }
  270.     }
  271. } else {
  272.     # Lack of alternative link => automatic mode
  273.     verbose(_g("setting up automatic selection of %s."), $alternative->name());
  274.     $alternative->set_status('auto');
  275. }
  276.  
  277. my $new_choice;
  278. if ($action eq 'set') {
  279.     $alternative->set_status('manual');
  280.     $new_choice = $path;
  281. } elsif ($action eq 'auto') {
  282.     $alternative->set_status('auto');
  283.     $new_choice = $alternative->best();
  284. } elsif ($action eq 'config') {
  285.     if (not scalar($alternative->choices())) {
  286.         pr(_g("There is no program which provides %s."), $alternative->name());
  287.         pr(_g("Nothing to configure."));
  288.     } elsif ($skip_auto && $alternative->status() eq 'auto') {
  289.         $alternative->display_user();
  290.     } elsif (scalar($alternative->choices()) == 1 and
  291.              $alternative->status() eq 'auto' and
  292.              $alternative->has_current_link()) {
  293.         pr(_g("There is only one alternative in link group %s: %s"),
  294.            $alternative->name(), $alternative->current());
  295.         pr(_g("Nothing to configure."));
  296.     } else {
  297.         $new_choice = $alternative->select_choice();
  298.     }
  299. } elsif ($action eq 'remove') {
  300.     if ($alternative->has_choice($path)) {
  301.         $alternative->remove_choice($path);
  302.     } else {
  303.         verbose(_g("alternative %s for %s not registered, not removing."),
  304.                 $path, $alternative->name());
  305.     }
  306.     if ($current_choice eq $path) {
  307.         # Current choice is removed
  308.         if ($alternative->status() eq "manual") {
  309.             # And it was manual, switch to auto
  310.             info(_g("removing manually selected alternative - " .
  311.                     "switching %s to auto mode"), $alternative->name());
  312.             $alternative->set_status('auto');
  313.         }
  314.         $new_choice = $alternative->best();
  315.     }
  316. } elsif ($action eq 'remove-all') {
  317.     foreach my $choice ($alternative->choices()) {
  318.         $alternative->remove_choice($choice);
  319.     }
  320. } elsif ($action eq 'install') {
  321.     if (defined($alternative->link())) {
  322.         # Alternative already exists, check if anything got updated
  323.         my ($old, $new) = ($alternative->link(), $inst_alt->link());
  324.         $alternative->set_link($new);
  325.         if ($old ne $new and -l $old) {
  326.             info(_g("renaming %s link from %s to %s."), $inst_alt->name(),
  327.                  $old, $new);
  328.             checked_mv($old, $new);
  329.         }
  330.         # Check if new slaves have been added, or existing ones renamed
  331.         foreach my $slave ($inst_alt->slaves()) {
  332.             $new = $inst_alt->slave_link($slave);
  333.             if (not $alternative->has_slave($slave)) {
  334.                 $alternative->add_slave($slave, $new);
  335.                 next;
  336.             }
  337.             $old = $alternative->slave_link($slave);
  338.             $alternative->add_slave($slave, $new);
  339.             my $new_file = ($current_choice eq $fileset->master()) ?
  340.                             $fileset->slave($slave) :
  341.                             readlink("$admdir/$slave") || "";
  342.             if ($old ne $new and -l $old) {
  343.                 if (-e $new_file) {
  344.                     info(_g("renaming %s slave link from %s to %s."),
  345.                          $slave,$old, $new);
  346.                     checked_mv($old, $new);
  347.                 } else {
  348.                     checked_rm($old);
  349.                 }
  350.             }
  351.         }
  352.     } else {
  353.         # Alternative doesn't exist, create from parameters
  354.         $alternative = $inst_alt;
  355.     }
  356.     $alternative->add_choice($fileset);
  357.     if ($alternative->status() eq "auto") {
  358.         # Update automatic choice if needed
  359.         $new_choice = $alternative->best();
  360.     } else {
  361.         verbose(_g("automatic updates of %s are disabled, leaving it alone."),
  362.                 "$altdir/" . $alternative->name());
  363.         verbose(_g("to return to automatic updates use ".
  364.                    "\`update-alternatives --auto %s'."), $alternative->name());
  365.     }
  366. }
  367.  
  368. # No choice left, remove everything
  369. if (not scalar($alternative->choices())) {
  370.     log_msg("link group " . $alternative->name() . " fully removed");
  371.     $alternative->remove();
  372.     exit 0;
  373. }
  374.  
  375. # New choice wanted
  376. if (defined($new_choice) and ($current_choice ne $new_choice)) {
  377.     log_msg("link group " . $alternative->name() .
  378.             " updated to point to " . $new_choice);
  379.     info(_g("using %s to provide %s (%s) in %s."), $new_choice,
  380.          $alternative->link(), $alternative->name(),
  381.          ($alternative->status() eq "auto" ? _g("auto mode") : _g("manual mode")));
  382.     $alternative->prepare_install($new_choice);
  383. } elsif ($alternative->is_broken()) {
  384.     log_msg("auto-repair link group " . $alternative->name());
  385.     warning(_g("forcing reinstallation of alternative %s " .
  386.                "because link group %s is broken."),
  387.             $current_choice, $alternative->name());
  388.     $alternative->prepare_install($current_choice) if $current_choice;
  389. }
  390.  
  391. # Save administrative file if needed
  392. if ($alternative->is_modified()) {
  393.     $alternative->save("$admdir/" . $alternative->name() . ".dpkg-tmp");
  394.     checked_mv("$admdir/" . $alternative->name() . ".dpkg-tmp",
  395.                "$admdir/" . $alternative->name());
  396. }
  397.  
  398. # Replace all symlinks in one pass
  399. $alternative->commit();
  400.  
  401. exit 0;
  402.  
  403. ### FUNCTIONS ####
  404. sub version {
  405.     printf _g("Debian %s version %s.\n"), $progname, $version;
  406.  
  407.     printf _g("
  408. Copyright (C) 1995 Ian Jackson.
  409. Copyright (C) 2000-2002 Wichert Akkerman.
  410. Copyright (C) 2009 Raphael Hertzog.");
  411.  
  412.     printf _g("
  413. This is free software; see the GNU General Public Licence version 2 or
  414. later for copying conditions. There is NO warranty.
  415. ");
  416. }
  417.  
  418. sub usage {
  419.     printf _g(
  420. "Usage: %s [<option> ...] <command>
  421.  
  422. Commands:
  423.   --install <link> <name> <path> <priority>
  424.     [--slave <link> <name> <path>] ...
  425.                            add a group of alternatives to the system.
  426.   --remove <name> <path>   remove <path> from the <name> group alternative.
  427.   --remove-all <name>      remove <name> group from the alternatives system.
  428.   --auto <name>            switch the master link <name> to automatic mode.
  429.   --display <name>         display information about the <name> group.
  430.   --query <name>           machine parseable version of --display <name>.
  431.   --list <name>            display all targets of the <name> group.
  432.   --config <name>          show alternatives for the <name> group and ask the
  433.                            user to select which one to use.
  434.   --set <name> <path>      set <path> as alternative for <name>.
  435.   --all                    call --config on all alternatives.
  436.  
  437. <link> is the symlink pointing to %s/<name>.
  438.   (e.g. /usr/bin/pager)
  439. <name> is the master name for this link group.
  440.   (e.g. pager)
  441. <path> is the location of one of the alternative target files.
  442.   (e.g. /usr/bin/less)
  443. <priority> is an integer; options with higher numbers have higher priority in
  444.   automatic mode.
  445.  
  446. Options:
  447.   --altdir <directory>     change the alternatives directory.
  448.   --admindir <directory>   change the administrative directory.
  449.   --skip-auto              skip prompt for alternatives correctly configured
  450.                            in automatic mode (relevant for --config only)
  451.   --verbose                verbose operation, more output.
  452.   --quiet                  quiet operation, minimal output.
  453.   --help                   show this help message.
  454.   --version                show the version.
  455. "), $progname, $altdir;
  456. }
  457.  
  458. sub error {
  459.     my ($format, @params) = @_;
  460.     $! = 2;
  461.     die sprintf("%s: %s: %s\n", $progname, _g("error"),
  462.                 sprintf($format, @params));
  463. }
  464.  
  465. sub badusage {
  466.     my ($format, @params) = @_;
  467.     printf STDERR "%s: %s\n\n", $progname, sprintf($format, @params);
  468.     usage();
  469.     exit(2);
  470. }
  471.  
  472. sub warning {
  473.     my ($format, @params) = @_;
  474.     if ($verbosemode >= 0) {
  475.         printf STDERR "%s: %s: %s\n", $progname, _g("warning"),
  476.                       sprintf($format, @params);
  477.     }
  478. }
  479.  
  480. sub msg {
  481.     my ($min_level, $format, @params) = @_;
  482.     if ($verbosemode >= $min_level) {
  483.         printf STDOUT "%s: %s\n", $progname, sprintf($format, @params);
  484.     }
  485. }
  486.  
  487. sub verbose {
  488.     msg(1, @_);
  489. }
  490.  
  491. sub info {
  492.     msg(0, @_);
  493. }
  494.  
  495. sub pr {
  496.     my ($format, @params) = @_;
  497.     printf ($format . "\n", @params);
  498. }
  499.  
  500. sub set_action {
  501.     my ($value) = @_;
  502.     if ($action) {
  503.         badusage(_g("two commands specified: --%s and --%s"), $value, $action);
  504.     }
  505.     $action = $value;
  506. }
  507.  
  508. {
  509.     my $fh_log;
  510.     sub log_msg {
  511.         my ($msg) = @_;
  512.         # XXX: the C rewrite must use the std function to get the
  513.         # filename from /etc/dpkg/dpkg.cfg or from command line
  514.         if (!defined($fh_log) and -w $log_file) {
  515.             open($fh_log, ">>", $log_file) ||
  516.                 error(_g("Can't append to %s"), $log_file);
  517.         }
  518.         if (defined($fh_log)) {
  519.             $msg = POSIX::strftime("%Y-%m-%d %H:%M:%S", localtime()) .
  520.                    " $progname: $msg\n";
  521.             print $fh_log $msg;
  522.         }
  523.     }
  524. }
  525.  
  526. sub get_all_alternatives {
  527.     opendir(ADMINDIR, $admdir)
  528.         or error(_g("can't readdir %s: %s"), $admdir, $!);
  529.     my @filenames = grep { !/^\.\.?$/ and !/\.dpkg-tmp$/ } (readdir(ADMINDIR));
  530.     close(ADMINDIR);
  531.     return sort @filenames;
  532. }
  533.  
  534. sub config_all {
  535.     foreach my $name (get_all_alternatives()) {
  536.         system($0, @pass_opts, "--config", $name);
  537.         exit $? if $?;
  538.         print "\n";
  539.     }
  540. }
  541.  
  542. sub rename_mv {
  543.     my ($source, $dest) = @_;
  544.     lstat($source);
  545.     return 0 if not -e _;
  546.     if (not rename($source, $dest)) {
  547.         if (system("mv", $source, $dest) != 0) {
  548.             return 0;
  549.         }
  550.     }
  551.     return 1;
  552. }
  553.  
  554. sub checked_symlink {
  555.     my ($filename, $linkname) = @_;
  556.     symlink($filename, $linkname) ||
  557.         error(_g("unable to make %s a symlink to %s: %s"), $linkname, $filename, $!);
  558. }
  559.  
  560. sub checked_mv {
  561.     my ($source, $dest) = @_;
  562.     rename_mv($source, $dest) ||
  563.         error(_g("unable to install %s as %s: %s"), $source, $dest, $!);
  564. }
  565.  
  566. sub checked_rm {
  567.     my ($f) = @_;
  568.     unlink($f) || $! == ENOENT || error(_g("unable to remove %s: %s"), $f, $!);
  569. }
  570.  
  571. ### OBJECTS ####
  572.  
  573. package FileSet;
  574.  
  575. use Dpkg::Gettext;
  576.  
  577. sub new {
  578.     my ($class, $master_file, $prio) = @_;
  579.     my $self = {
  580.         "master_file" => $master_file,
  581.         "priority" => $prio,
  582.         "slaves" =>
  583.             {
  584.                 # "slave_name" => "slave_file"
  585.             },
  586.     };
  587.     return bless $self, $class;
  588. }
  589. sub add_slave {
  590.     my ($self, $name, $file) = @_;
  591.     $self->{slaves}{$name} = $file;
  592. }
  593. sub has_slave {
  594.     my ($self, $slave) = @_;
  595.     return (exists $self->{"slaves"}{$slave} and $self->{"slaves"}{$slave});
  596. }
  597. sub master {
  598.     my ($self, $val) = @_;
  599.     return $self->{"master_file"};
  600. }
  601. sub priority {
  602.     my ($self) = @_;
  603.     return $self->{"priority"};
  604. }
  605. sub slave {
  606.     my ($self, $slave) = @_;
  607.     return $self->{"slaves"}{$slave};
  608. }
  609.  
  610. package Alternative;
  611.  
  612. use Dpkg::Gettext;
  613. use POSIX qw(:errno_h);
  614.  
  615. sub pr { main::pr(@_) }
  616. sub error { main::error(@_) }
  617.  
  618. sub new {
  619.     my ($class, $name) = @_;
  620.     my $self = {};
  621.     bless $self, $class;
  622.     $self->reset($name);
  623.     return $self;
  624. }
  625. sub reset {
  626.     my ($self, $name) = @_;
  627.     my $new = {
  628.         "master_name" => $name,
  629.         "master_link" => undef,
  630.         "status" => undef,
  631.         "slaves" => {
  632.             # "slave_name" => "slave_link"
  633.         },
  634.         "choices" => {
  635.             # "master_file" => $fileset
  636.         },
  637.         "modified" => 0,
  638.         "commit_ops" => [],
  639.     };
  640.     %$self = %$new;
  641. }
  642. sub choices {
  643.     my ($self) = @_;
  644.     my @choices = sort { $a cmp $b } keys %{$self->{choices}};
  645.     return wantarray ? @choices : scalar(@choices);
  646. }
  647. sub slaves {
  648.     my ($self) = @_;
  649.     my @slaves = sort { $a cmp $b } keys %{$self->{slaves}};
  650.     return wantarray ? @slaves : scalar(@slaves);
  651. }
  652. sub name {
  653.     my ($self) = @_;
  654.     return $self->{master_name};
  655. }
  656. sub link {
  657.     my ($self) = @_;
  658.     return $self->{master_link};
  659. }
  660. sub status {
  661.     my ($self) = @_;
  662.     return $self->{status};
  663. }
  664. sub fileset {
  665.     my ($self, $id) = @_;
  666.     return $self->{choices}{$id} if exists $self->{choices}{$id};
  667.     return undef;
  668. }
  669. sub slave_link {
  670.     my ($self, $id) = @_;
  671.     return $self->{slaves}{$id} if exists $self->{slaves}{$id};
  672.     return undef;
  673. }
  674. sub has_slave {
  675.     my ($self, $slave) = @_;
  676.     return (exists $self->{"slaves"}{$slave} and $self->{"slaves"}{$slave});
  677. }
  678. sub is_modified {
  679.     my ($self) = @_;
  680.     return $self->{modified};
  681. }
  682. sub has_choice {
  683.     my ($self, $id) = @_;
  684.     return exists $self->{choices}{$id};
  685. }
  686. sub add_choice {
  687.     my ($self, $fileset) = @_;
  688.     $self->{choices}{$fileset->master()} = $fileset;
  689.     $self->{modified} = 1; # XXX: be smarter in detecting change ?
  690. }
  691. sub add_slave {
  692.     my ($self, $slave, $link) = @_;
  693.     $self->{slaves}{$slave} = $link;
  694. }
  695. sub set_status {
  696.     my ($self, $status) = @_;
  697.     if (!defined($self->status()) or $status ne $self->status()) {
  698.         $self->{modified} = 1;
  699.     }
  700.     main::log_msg("status of link group " . $self->name() . " set to $status")
  701.         if defined($self->status()) and $status ne $self->status();
  702.     $self->{status} = $status;
  703. }
  704. sub set_link {
  705.     my ($self, $link) = @_;
  706.     if (!defined($self->link()) or $link ne $self->link()) {
  707.         $self->{modified} = 1;
  708.     }
  709.     $self->{master_link} = $link;
  710. }
  711. sub remove_choice {
  712.     my ($self, $id) = @_;
  713.     if ($self->has_choice($id)) {
  714.         delete $self->{choices}{$id};
  715.         $self->{modified} = 1;
  716.         return 1;
  717.     }
  718.     return 0;
  719. }
  720.  
  721. {
  722.     # Helper functions for load() and save()
  723.     my ($fh, $filename);
  724.     sub config_helper {
  725.         ($fh, $filename) = @_;
  726.     }
  727.     sub gl {
  728.         undef $!;
  729.         my $line = <$fh>;
  730.         unless (defined($line)) {
  731.             error(_g("while reading %s: %s"), $filename, $!) if $!;
  732.             error(_g("unexpected end of file in %s while trying to read %s"),
  733.                  $filename, $_[0]);
  734.         }
  735.         chomp($line);
  736.         return $line;
  737.     }
  738.     sub badfmt {
  739.         my ($format, @params) = @_;
  740.         error(_g("%s corrupt: %s"), $filename, sprintf($format, @params));
  741.     }
  742.     sub paf {
  743.         my $line = shift @_;
  744.         if ($line =~ m/\n/) {
  745.             error(_g("newlines prohibited in update-alternatives files (%s)"), $line);
  746.         }
  747.         print $fh "$line\n" || error(_g("while writing %s: %s"), $filename, $!);
  748.     }
  749. }
  750.  
  751. sub load {
  752.     my ($self, $file, $must_not_die) = @_;
  753.     return 0 unless -s $file;
  754.     eval {
  755.         open(my $fh, "<", $file) || error(_g("unable to read %s: %s"), $file, $!);
  756.         config_helper($fh, $file);
  757.     my $status = gl(_g("status"));
  758.     badfmt(_g("invalid status")) unless $status =~ /^(?:auto|manual)$/;
  759.     my $link = gl("link");
  760.         my (%slaves, @slaves);
  761.     while ((my $slave_name = gl(_g("slave name"))) ne '') {
  762.         my $slave_link = gl(_g("slave link"));
  763.         badfmt(_g("duplicate slave %s"), $slave_name)
  764.                 if exists $slaves{$slave_name};
  765.         badfmt(_g("slave link same as main link %s"), $link)
  766.                 if $slave_link eq $link;
  767.             badfmt(_g("duplicate slave link %s"), $slave_link)
  768.                 if grep { $_ eq $slave_link } values %slaves;
  769.             $slaves{$slave_name} = $slave_link;
  770.             push @slaves, $slave_name;
  771.     }
  772.         my @filesets;
  773.         my $modified = 0;
  774.     while ((my $main_file = gl(_g("master file"))) ne '') {
  775.         badfmt(_g("duplicate path %s"), $main_file)
  776.                 if grep { $_->{master_file} eq $main_file } @filesets;
  777.         if (-e $main_file) {
  778.         my $priority = gl(_g("priority"));
  779.                 badfmt(_g("priority of %s: %s"), $main_file, $priority)
  780.                     unless $priority =~ m/^[-+]?\d+$/;
  781.                 my $group = FileSet->new($main_file, $priority);
  782.                 foreach my $slave (@slaves) {
  783.                     $group->add_slave($slave, gl(_g("slave file")));
  784.         }
  785.                 push @filesets, $group;
  786.         } else {
  787.         # File not found - remove
  788.         main::warning(_g("alternative %s (part of link group %s) " .
  789.                                  "doesn't exist. Removing from list of ".
  790.                                  "alternatives."),
  791.                               $main_file, $self->name()) unless $must_not_die;
  792.         gl(_g("priority"));
  793.                 foreach my $slave (@slaves) {
  794.             gl(_g("slave file"));
  795.         }
  796.                 $modified = 1;
  797.         }
  798.     }
  799.         close($fh);
  800.         # We parsed the file without trouble, load data into the object
  801.         $self->{master_link} = $link;
  802.         $self->{slaves} = \%slaves;
  803.         $self->{status} = $status;
  804.         $self->{modified} = $modified;
  805.         $self->{choices} = {};
  806.         foreach my $group (@filesets) {
  807.             $self->{choices}{$group->master()} = $group;
  808.         }
  809.     };
  810.     if ($@) {
  811.         return 0 if $must_not_die;
  812.         die $@;
  813.     }
  814.     return 1;
  815. }
  816.  
  817. sub save {
  818.     my ($self, $file) = @_;
  819.     # Cleanup unused slaves before writing admin file
  820.     foreach my $slave ($self->slaves()) {
  821.         my $has_slave = 0;
  822.         foreach my $choice ($self->choices()) {
  823.             my $fileset = $self->fileset($choice);
  824.             $has_slave++ if $fileset->has_slave($slave);
  825.         }
  826.         unless ($has_slave) {
  827.             main::verbose(_g("discarding obsolete slave link %s (%s)."),
  828.                           $slave, $self->slave_link($slave));
  829.             delete $self->{"slaves"}{$slave};
  830.         }
  831.     }
  832.     # Write admin file
  833.     open(my $fh, ">", $file) || error(_g("unable to write %s: %s"), $file, $!);
  834.     config_helper($fh, $file);
  835.     paf($self->status());
  836.     paf($self->link());
  837.     foreach my $slave ($self->slaves()) {
  838.         paf($slave);
  839.         paf($self->slave_link($slave));
  840.     }
  841.     paf('');
  842.     foreach my $choice ($self->choices()) {
  843.         paf($choice);
  844.         my $fileset = $self->fileset($choice);
  845.         paf($fileset->priority());
  846.         foreach my $slave ($self->slaves()) {
  847.             if ($fileset->has_slave($slave)) {
  848.                 paf($fileset->slave($slave));
  849.             } else {
  850.                 paf('');
  851.             }
  852.         }
  853.     }
  854.     paf('');
  855.     close($fh) || error(_g("unable to close %s: %s"), $file, $!);
  856. }
  857.  
  858. sub display_query {
  859.     my ($self) = @_;
  860.     pr("Link: %s", $self->name());
  861.     pr("Status: %s", $self->status());
  862.     my $best = $self->best();
  863.     if (defined($best)) {
  864.     pr("Best: %s", $best);
  865.     }
  866.     if ($self->has_current_link()) {
  867.     pr("Value: %s", $self->current());
  868.     } else {
  869.     pr("Value: none");
  870.     }
  871.  
  872.     foreach my $choice ($self->choices()) {
  873.     pr("");
  874.     pr("Alternative: %s", $choice);
  875.         my $fileset = $self->fileset($choice);
  876.     pr("Priority: %s", $fileset->priority());
  877.     next unless scalar($self->slaves());
  878.     pr("Slaves:");
  879.         foreach my $slave ($self->slaves()) {
  880.             if ($fileset->has_slave($slave)) {
  881.             pr(" %s %s", $slave, $fileset->slave($slave));
  882.             }
  883.         }
  884.     }
  885. }
  886.  
  887. sub display_user {
  888.     my ($self) = @_;
  889.     pr("%s - %s", $self->name(),
  890.         ($self->status() eq "auto") ? _g("auto mode") : _g("manual mode"));
  891.  
  892.     if ($self->has_current_link()) {
  893.     pr(_g(" link currently points to %s"), $self->current());
  894.     } else {
  895.     pr(_g(" link currently absent"));
  896.     }
  897.     foreach my $choice ($self->choices()) {
  898.         my $fileset = $self->fileset($choice);
  899.     pr(_g("%s - priority %s"), $choice, $fileset->priority());
  900.         foreach my $slave ($self->slaves()) {
  901.             if ($fileset->has_slave($slave)) {
  902.                 pr(_g(" slave %s: %s"), $slave, $fileset->slave($slave));
  903.             }
  904.     }
  905.     }
  906.  
  907.     my $best = $self->best();
  908.     if (defined($best) && $best) {
  909.     pr(_g("Current \`best' version is %s."), $best);
  910.     } else {
  911.     pr(_g("No versions available."));
  912.     }
  913. }
  914.  
  915. sub display_list {
  916.     my ($self) = @_;
  917.     pr($_) foreach ($self->choices());
  918. }
  919.  
  920. sub select_choice {
  921.     my ($self) = @_;
  922.     while (1) {
  923.         my $current = $self->current() || "";
  924.         my $best = $self->best();
  925.         printf _g("There are %s choices for the alternative %s (providing %s).") . "\n\n",
  926.                scalar($self->choices()), $self->name(), $self->link();
  927.         my $length = 15;
  928.         foreach ($self->choices()) {
  929.             $length = (length($_) > $length) ? length($_) + 1 : $length;
  930.         }
  931.         printf "  %-12.12s %-${length}.${length}s %-10.10s %s\n", _g("Selection"),
  932.                _g("Path"), _g("Priority"), _g("Status");
  933.         print "-" x 60 . "\n";
  934.         printf "%s %-12d %-${length}s % -10d %s\n",
  935.                ($self->status() eq "auto" and $current eq $best) ? "*" : " ", 0,
  936.                $best, $self->fileset($best)->priority(), _g("auto mode");
  937.         my $index = 1;
  938.         my %sel = ("0" => $best);
  939.         foreach my $choice ($self->choices()) {
  940.             $sel{$index} = $choice;
  941.             $sel{$choice} = $choice;
  942.             printf "%s %-12d %-${length}.${length}s % -10d %s\n",
  943.                    ($self->status() eq "manual" and $current eq $choice) ?  "*" : " ",
  944.                    $index, $choice, $self->fileset($choice)->priority(),
  945.                    _g("manual mode");
  946.             $index++;
  947.         }
  948.         print "\n";
  949.         printf _g("Press enter to keep the current choice[*], or type selection number: ");
  950.         my $selection = <STDIN>;
  951.         return undef unless defined($selection);
  952.         chomp($selection);
  953.         return ($current || $best) if $selection eq "";
  954.         if (exists $sel{$selection}) {
  955.             $self->set_status(($selection eq "0") ? "auto" : "manual");
  956.             return $sel{$selection};
  957.         }
  958.     }
  959. }
  960.  
  961.  
  962. sub best {
  963.     my ($self) = @_;
  964.     my @choices = sort { $self->fileset($b)->priority() <=>
  965.                          $self->fileset($a)->priority()
  966.                   } ($self->choices());
  967.     if (scalar(@choices)) {
  968.         return $choices[0];
  969.     } else {
  970.         return undef;
  971.     }
  972. }
  973.  
  974. sub has_current_link {
  975.     my ($self) = @_;
  976.     return -l "$altdir/$self->{master_name}";
  977. }
  978.  
  979. sub current {
  980.     my ($self) = @_;
  981.     return undef unless $self->has_current_link();
  982.     my $val = readlink("$altdir/$self->{master_name}");
  983.     error(_g("readlink(%s) failed: %s"), "$altdir/$self->{master_name}", $!)
  984.         unless defined $val;
  985.     return $val;
  986. }
  987.  
  988. sub add_commit_op {
  989.     my ($self, $sub) = @_;
  990.     push @{$self->{commit_ops}}, $sub;
  991. }
  992. sub prepare_install {
  993.     my ($self, $choice) = @_;
  994.     my ($link, $name) = ($self->link(), $self->name());
  995.     my $fileset = $self->fileset($choice);
  996.     main::error("can't install unknown choice %s", $choice)
  997.         if not defined($choice);
  998.     # Create link in /etc/alternatives
  999.     main::checked_rm("$altdir/$name.dpkg-tmp");
  1000.     main::checked_symlink($choice, "$altdir/$name.dpkg-tmp");
  1001.     $self->add_commit_op(sub {
  1002.         main::checked_mv("$altdir/$name.dpkg-tmp", "$altdir/$name");
  1003.     });
  1004.     $! = 0; lstat($link);
  1005.     if (-l _ or $! == ENOENT or $force) {
  1006.         # Create alternative link
  1007.         main::checked_rm("$link.dpkg-tmp");
  1008.         main::checked_symlink("$altdir/$name", "$link.dpkg-tmp");
  1009.         $self->add_commit_op(sub {
  1010.             main::checked_mv("$link.dpkg-tmp", $link);
  1011.         });
  1012.     } else {
  1013.         main::warning(_g("not replacing %s with a link."), $link);
  1014.     }
  1015.     # Take care of slaves links
  1016.     foreach my $slave ($self->slaves()) {
  1017.         my ($slink, $spath) = ($self->slave_link($slave), $fileset->slave($slave));
  1018.         if ($fileset->has_slave($slave) and -e $spath) {
  1019.             # Create link in /etc/alternatives
  1020.             main::checked_rm("$altdir/$slave.dpkg-tmp");
  1021.             main::checked_symlink($spath, "$altdir/$slave.dpkg-tmp");
  1022.             $self->add_commit_op(sub {
  1023.                 main::checked_mv("$altdir/$slave.dpkg-tmp", "$altdir/$slave");
  1024.             });
  1025.             $! = 0; lstat($slink);
  1026.             if (-l _ or $! == ENOENT or $force) {
  1027.                 # Create alternative link
  1028.                 main::checked_rm("$slink.dpkg-tmp");
  1029.                 main::checked_symlink("$altdir/$slave", "$slink.dpkg-tmp");
  1030.                 $self->add_commit_op(sub {
  1031.                     main::checked_mv("$slink.dpkg-tmp", $slink);
  1032.                 });
  1033.             } else {
  1034.                 main::warning(_g("not replacing %s with a link."), $slink);
  1035.             }
  1036.         } else {
  1037.             main::warning(_g("skip creation of %s because associated file " .
  1038.                              "%s (of link group %s) doesn't exist."),
  1039.                           $slink, $spath, $self->name())
  1040.                 if $fileset->has_slave($slave);
  1041.             # Drop unused slave
  1042.             $self->add_commit_op(sub {
  1043.                 main::checked_rm($slink);
  1044.                 main::checked_rm("$altdir/$slave");
  1045.             });
  1046.         }
  1047.     }
  1048. }
  1049.  
  1050. sub remove {
  1051.     my ($self) = @_;
  1052.     my ($link, $name) = ($self->link(), $self->name());
  1053.     main::checked_rm("$link.dpkg-tmp");
  1054.     main::checked_rm($link) if -l $link;
  1055.     main::checked_rm("$altdir/$name.dpkg-tmp");
  1056.     main::checked_rm("$altdir/$name");
  1057.     foreach my $slave ($self->slaves()) {
  1058.         my $slink = $self->slave_link($slave);
  1059.         main::checked_rm("$slink.dpkg-tmp");
  1060.         main::checked_rm($slink) if -l $slink;
  1061.         main::checked_rm("$altdir/$slave.dpkg-tmp");
  1062.         main::checked_rm("$altdir/$slave");
  1063.     }
  1064.     # Drop admin file
  1065.     main::checked_rm("$admdir/$name");
  1066. }
  1067.  
  1068. sub commit {
  1069.     my ($self) = @_;
  1070.     foreach my $sub (@{$self->{commit_ops}}) {
  1071.         &$sub();
  1072.     }
  1073.     $self->{commit_ops} = [];
  1074. }
  1075.  
  1076. sub is_broken {
  1077.     my ($self) = @_;
  1078.     my $name = $self->name();
  1079.     return 1 if not $self->has_current_link();
  1080.     # Check master link
  1081.     my $file = readlink($self->link());
  1082.     return 1 if not defined($file);
  1083.     return 1 if $file ne "$altdir/$name";
  1084.     # Stop if we have an unmanaged alternative
  1085.     return 0 if not $self->has_choice($self->current());
  1086.     # Check slaves
  1087.     my $fileset = $self->fileset($self->current());
  1088.     foreach my $slave ($self->slaves()) {
  1089.         $file = readlink($self->slave_link($slave));
  1090.         if ($fileset->has_slave($slave) and -e $fileset->slave($slave)) {
  1091.             return 1 if not defined($file);
  1092.             return 1 if $file ne "$altdir/$slave";
  1093.             $file = readlink("$altdir/$slave");
  1094.             return 1 if not defined($file);
  1095.             return 1 if $file ne $fileset->slave($slave);
  1096.         } else {
  1097.             # Slave link must not exist
  1098.             return 1 if defined($file);
  1099.             $file = readlink("$altdir/$slave");
  1100.             return 1 if defined($file);
  1101.         }
  1102.     }
  1103.     return 0;
  1104. }
  1105. # vim: nowrap ts=8 sw=4
  1106.